10_calcul_indicateurs_par_ope
Ce script permet de constituer les tableaux de données nécessaires à la réalisation des analyses temporelles. Plusieurs indicateurs seront calculés à l’échelle des opérations de pêches, parmi eux : les densités volumiques, de surface, les pourcentages de juvéniles, les longueurs médianes, … Ces indicateurs sont calculés par espèces, pour les juvéniles et les adultes, mais également de manière combinée (indeterminés).
## Chargement des packages ----
library(tidyverse)
library(aspe)
library(ggplot2)
library(ggthemes)
library(dplyr)
library(readxl)
## Chargement des données pré-enregistrées ----
load(file = "../processed_data/selection_pop_ope.rda")
load(file = "../processed_data/pre_traitements_donnees_env.rda")
load(file = "../processed_data/analyse_selection_especes.rda")
load(file = "../processed_data/pre_traitements_donnees_especes.rda")
#Chargement des tables ASPE ----
rdata_tables <- misc_nom_dernier_fichier(
repertoire = "../../../../projets/ASPE/raw_data/rdata",
pattern = "^tables")
load(rdata_tables)
mei_table <- misc_nom_dernier_fichier(
repertoire = "../../../../projets/ASPE/raw_data/rdata",
pattern = "^mei")
load(mei_table)
## Chargement des fonctions ----
source(file = "../R/calcul_biomasse.R")
source(file = "../R/calcul_50_percentile.R")
source(file = "../R/calcul_ecart_interquartile.R")
source(file = "../R/calcul_25_percentile.R")
source(file = "../R/calcul_75_percentile.R")
source(file = "../R/calcul_densite_surface.R")
ope_effectif <- mei_ope_selection %>%
group_by(ope_id, esp_code_alternatif) %>%
distinct(mei_id, .keep_all = TRUE) %>%
summarise(valeur = n_distinct(mei_id)) %>%
mutate(indicateur = "effectif_total", stade = "ind") %>%
select(ope_id,
esp_code_alternatif,
indicateur,
valeur,
stade)
ope_effectif_stade <- mei_ope_selection %>%
group_by(ope_id,
esp_code_alternatif,
stade
) %>%
summarise(valeur=length(lop_effectif)) %>%
mutate(indicateur= "effectif_total") %>%
select(ope_id,
esp_code_alternatif,
indicateur,
valeur,
stade
)
ope_effectif <- rbind (ope_effectif,ope_effectif_stade)
# Calcul de la biomasse par opération : par espèce et par stade :
ope_biomasse <- mei_ope_selection %>%
group_by(ope_id,
esp_code_alternatif,
stade) %>%
summarise(valeur=sum(poids_tp, na.rm = TRUE)) %>%
mutate(indicateur= "biomasse") %>%
select(ope_id,
esp_code_alternatif,
indicateur,
valeur,
stade)
ope_biomasse <- ope_biomasse %>%
bind_rows(ope_biomasse %>%
filter(stade %in% c("ad", "juv")) %>%
group_by(indicateur, ope_id, esp_code_alternatif) %>%
summarise(stade = "ind", valeur = sum(valeur)))
# Ajout des données de surfaces échantillonnées dans mei_esp_ope_selection ----
mei_ope_selection <- mei_ope_selection %>%
left_join (y=operation %>%
select (ope_id,
ope_surface_calculee,
passage$pas_numero))
ope_densite_surf <- calcul_densite_surface(mei_ope_selection,
ope_surface_calculee,
ope_id,
esp_code_alternatif,
stade,
mei_id)
#Ajout des données de profondeurs :
ope_param_profondeur <- ope_selection_param_env %>%
filter(parametre == "profondeur") %>%
select(ope_id,
valeur) %>%
rename(profondeur=valeur) %>%
distinct()
densite_surf <- ope_densite_surf %>%
rename(valeur_ds = valeur)
ope_densite_vol<- left_join(ope_param_profondeur, densite_surf, by = "ope_id") %>%
mutate(valeur = valeur_ds /profondeur) %>%
ungroup() %>%
mutate(indicateur = "densite_volumique") %>%
select(ope_id,
esp_code_alternatif,
indicateur,
valeur,
stade)
ope_pc_juv <- ope_effectif %>%
mutate(indicateur = "pourcentage_juveniles")
ope_pc_juv <- ope_pc_juv %>%
ungroup() %>%
complete(ope_id,
esp_code_alternatif,
stade,
indicateur,
fill = list(valeur = 0)) %>%
group_by(ope_id,
esp_code_alternatif) %>%
mutate(valeur = (valeur [stade == "juv"] / valeur [stade == "ind"])*100) %>%
filter(stade == "ind",
!is.nan(valeur))
Calcul des longueurs médianes des tailles des individus par opération : Création de la fonction “calcul_50_percentile” :
ope_lm <- calcul_50_percentile(mei_ope_selection,
mei_taille,
ope_id,
esp_code_alternatif,
stade)
Calcul des écarts interquartiles des tailles des individus par opération : Création de la fonction “calcul_ecart_interquartile” :
ope_ecart_inter <- calcul_ecart_inter(mei_ope_selection,
mei_taille,
ope_id,
esp_code_alternatif,
stade)
Calcul des percentiles 25 et 75 des tailles des individus par opération : Création de la fonction “calcul_25_percentile” et “calcul_75_percentile” :
ope_p25 <- calcul_p25(mei_ope_selection,
mei_taille,
ope_id,
esp_code_alternatif,
stade)
ope_p75 <- calcul_p75(mei_ope_selection,
mei_taille,
ope_id,
esp_code_alternatif,
stade)
On calcul le pourcentage des sites prospectés où l’espèce a été trouvée :
ope_biomasse1 <- ope_biomasse %>%
filter (stade == "ind")
combinaisons <- expand.grid(esp_code_alternatif = unique(ope_biomasse1$esp_code_alternatif),
ope_id = unique(ope_biomasse$ope_id))
# Fusionner les combinaisons avec le dataframe initial
reg_pc_site_presence_esp <- combinaisons %>%
left_join(ope_biomasse1, by = c("esp_code_alternatif", "ope_id")) %>%
mutate(present = !is.na(indicateur)) %>%
group_by(esp_code_alternatif) %>%
mutate(
stade = "ind",
indicateur = "pourcentage_site_presence_esp",
valeur = sum(present) / n_distinct(ope_id) * 100
) %>%
select(-present)
# Affichage du résultat
print(reg_pc_site_presence_esp)
## # A tibble: 26,275 × 5
## # Groups: esp_code_alternatif [25]
## esp_code_alternatif ope_id indicateur valeur stade
## <chr> <int> <chr> <dbl> <chr>
## 1 ANG 5131 pourcentage_site_presence_esp 83.2 ind
## 2 CHA 5131 pourcentage_site_presence_esp 83.3 ind
## 3 LOF 5131 pourcentage_site_presence_esp 91.9 ind
## 4 TRF 5131 pourcentage_site_presence_esp 81.3 ind
## 5 VAI 5131 pourcentage_site_presence_esp 74.7 ind
## 6 LPP 5131 pourcentage_site_presence_esp 53.7 ind
## 7 SAT 5131 pourcentage_site_presence_esp 45.5 ind
## 8 BRO 5131 pourcentage_site_presence_esp 20.5 ind
## 9 CCO 5131 pourcentage_site_presence_esp 1.81 ind
## 10 EPI 5131 pourcentage_site_presence_esp 1.81 ind
## # ℹ 26,265 more rows
L’ensemble des indicateurs calculés sont regroupés dans le dataframe ope_indicateur.
# Création du tableau pré-final avec tous les indicateurs calculés
ope_indicateur <- rbind(ope_lm,
ope_densite_surf,
ope_densite_vol,
ope_pc_juv,
ope_biomasse,
ope_effectif,
reg_pc_site_presence_esp)
Les années d’opérations ainsi que les identifiant des point de prélèvements sont ajoutés au tableau ope_indicateur.
# Ajout des années d'opération au site et à l'année (pop_id) et (ope_date)
ope_indicateur <- ope_indicateur %>%
ungroup() %>%
left_join(y=operation %>%
select(ope_id,
pop_id= ope_pop_id,
ope_date)) %>%
mef_ajouter_ope_date() %>%
select(ope_id,
esp_code_alternatif,
indicateur,
valeur,
stade,
pop_id,
annee)
Visualisation du tableau final de données
#Représentation graphique du tableau
ope_indicateur%>%
DT::datatable(rownames = FALSE)
# SAUVEGARDE ----
save(ope_indicateur,
mei_ope_selection,
file = "../processed_data/assemblage_tab_par_ope.rda")